home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Libris Britannia 4
/
science library(b).zip
/
science library(b)
/
PROGRAMM
/
PASCAL
/
0195.ZIP
/
GETFREE.LIB
< prev
next >
Wrap
Text File
|
1984-12-18
|
1KB
|
52 lines
{@@@@@@@@@@@ copyright (C) 1984 by Neil J. Rubenking @@@@@@@@@@@@@@@@@@@@@@@@
The purchaser of these procedures and functions may include them in COMPILED
programs freely, but may not sell or give away the source text.
NOTE that any file that INCLUDES this file must also INCLUDE
the type definitions in REGPACK.TYP}
{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
procedure GetFree(drive : char; VAR FreeSpace : real; VAR OKAY : boolean);
const
HexTenThousand = 65536.;
var
regs : regpack;
available_clusters,
sectors_per_cluster,
bytes_per_sector : real;
begin
with regs do
begin
DX := ord(UpCase(drive)) - 64;
AX := $36 shl 8;
OKAY := true;
MSDOS(regs);
if AX = $FFFF then
begin
OKAY := false;
FreeSpace := 0;
end
else
begin
if BX < 0 then
available_clusters := BX + HexTenThousand
else available_clusters := BX;
if AX < 0 then
sectors_per_cluster := AX + HexTenThousand
else sectors_per_cluster := AX;
if CX < 0 then
bytes_per_sector := CX + HexTenThousand
else bytes_per_sector := CX;
FreeSpace := available_clusters*sectors_per_cluster*bytes_per_sector;
end;
end; {with}
end;